home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS25.ADF / SoftBallStats / SoftStats < prev    next >
Text File  |  1989-01-26  |  20KB  |  772 lines
  1.  CLEAR ,40000&
  2.  GOSUB ClearDB
  3.  
  4. MenuSetup:
  5.  MENU 1,0,1,"PROJECT"
  6.  MENU 1,1,1,"Open   "
  7.  MENU 1,2,1,"Save   "
  8.  MENU 1,3,1,"Print  "
  9.  MENU 1,4,1,"Quit   "
  10.  MENU 2,0,1,"ROSTER"
  11.  MENU 2,1,1,"Add   "
  12.  MENU 2,2,1,"Delete"
  13.  MENU 2,3,1,"New   "
  14.  MENU 3,0,1,"STATISTICS"
  15.  MENU 3,1,1,"Enter     "
  16.  MENU 4,0,1,"VIEW      "
  17.  MENU 4,1,1,"Game      "
  18.  MENU 4,2,1,"Cumulative"
  19.  MENU 4,3,1,"History   "
  20.  ON MENU GOSUB MenuHandler
  21.  NPlayers=NPMAX
  22.  GNumber=NGMAX
  23.  GOSUB Game
  24. Iloop:
  25.  MENU ON
  26.  WHILE -1: WEND
  27.  
  28. MenuHandler:
  29.  menuID=MENU(0)
  30.  itemID=MENU(1)
  31.  X=0:GOSUB Ghost
  32.  ON menuID GOSUB ProjectMenu,RosterMenu,StatisticsMenu,ViewMenu
  33.  X=1:GOSUB Ghost
  34. RETURN Iloop
  35.  
  36. ProjectMenu:
  37.  ON itemID GOSUB OpenFile,SaveFile,PrintFile,Quit
  38. RETURN
  39.  
  40. RosterMenu:
  41.  ON itemID GOSUB Add,Delete1,NewFile
  42. RETURN
  43.  
  44. StatisticsMenu:
  45.  ON itemID GOSUB Enter
  46. RETURN
  47.  
  48. ViewMenu:
  49.  ON itemID GOSUB Game,Cumulative,History
  50. RETURN
  51.  
  52. Ghost:
  53.  MENU 1,0,X
  54.  MENU 2,0,X
  55.  MENU 3,0,X
  56.  MENU 4,0,X
  57. RETURN:  
  58.  
  59. NewFile:
  60.  MENU OFF
  61.  Temp$=""
  62.  CALL StringRequest("NEW ROSTER","Enter Team Name","OK","CANCEL",Temp$)
  63.  IF which=3 THEN
  64.   Temp$=""
  65.   RETURN
  66.  END IF
  67.  ERASE work%,x1,x2,y1,y2
  68.  ERASE PlayerName$,PGameStats,PCumStats,GDates$
  69.  ERASE GScores$,TGameStats,TCumStats,TCumTotals
  70.  GOSUB ClearDB
  71.  CLS
  72.  TeamName$=Temp$
  73.  LOCATE 1,35:COLOR 2:PRINT TeamName$;" Roster":COLOR 1:PRINT 
  74. NameLoop:
  75.  NPlayers=NPlayers+1
  76.   IF NPlayers>NPMAX THEN
  77.   CALL Requester("Too Many","Players","OK","OK",0,X)
  78.   GOTO DoneName
  79.  END IF
  80.  Temp1$="Enter Name of Player "+STR$(NPlayers)
  81.  Temp$=""
  82.  CALL StringRequest("NEW ROSTER",Temp1$,"OK","DONE",Temp$)
  83.  IF which=3 AND Temp$="" THEN
  84.   GOTO DoneName
  85.  ELSEIF which=3 THEN
  86.   PlayerName$(NPlayers)=Temp$
  87.   NPlayers=NPlayers+1
  88.   GOTO DoneName
  89.  ELSE
  90.   PlayerName$(NPlayers)=Temp$
  91.  END IF 
  92.  LOCATE NPlayers+1,35: PRINT PlayerName$(NPlayers);
  93.  GOTO NameLoop
  94. DoneName:
  95.  NPlayers=NPlayers-1
  96.  GOSUB LastScreen
  97.  MENU ON 
  98. RETURN
  99.  
  100. OpenFile:
  101.  MENU OFF
  102.  Temp$=RIGHT$(STR$(GNumber),2)
  103.  IF GNumber<10 THEN Temp$=RIGHT$(STR$(GNumber),1)
  104.  filname$=TeamName$+".Game"+Temp$
  105.  X=MOUSE(0)
  106.  CALL OpenRequest(filname$)
  107.  IF which=3 THEN RETURN
  108.  EFlag$="OPEN" 
  109.  ERASE work%,x1,x2,y1,y2
  110.  ERASE PlayerName$,PGameStats,PCumStats,GDates$
  111.  ERASE GScores$,TGameStats,TCumStats,TCumTotals
  112.  GOSUB ClearDB
  113.  ON ERROR GOTO ErrorTrap
  114.  OPEN filname$ FOR INPUT AS #1
  115.  INPUT #1,TeamName$,GNumber,NPlayers,NWins,NLosses,NCSTATS,NGSTATS
  116.  FOR I=1 TO NPlayers
  117.   INPUT #1,PlayerName$(I)
  118.   FOR J=1 TO NGSTATS
  119.    INPUT #1,PGameStats(I,J)
  120.   NEXT J
  121.   FOR  J=1 TO NCSTATS
  122.    INPUT #1,PCumStats(I,J)
  123.   NEXT J
  124.  NEXT I
  125.  FOR I=1 TO GNumber
  126.   INPUT #1,GDates$(I),GScores$(I)
  127.   FOR J=1 TO NCSTATS
  128.    INPUT #1,TCumStats(I,J)
  129.   NEXT J
  130.  NEXT I
  131.  FOR I=1 TO NGSTATS
  132.   INPUT #1,TGameStats(I)
  133.  NEXT I
  134.  FOR J=1 TO NCSTATS
  135.   INPUT #1,TCumTotals(J)
  136.  NEXT J 
  137.  CLOSE #1
  138.  ON ERROR GOTO 0
  139.  FileFlag$="F"
  140.  GOSUB LastScreen
  141. RETURN
  142.  
  143. SaveFile:
  144.  MENU OFF
  145.  Temp$=RIGHT$(STR$(GNumber),2)
  146.  IF GNumber<10 THEN Temp$=RIGHT$(STR$(GNumber),1)
  147.  filename$=TeamName$+".Game"+Temp$
  148.  X=MOUSE(0)
  149.  CALL SaveRequest(filename$)
  150.  IF which=3 THEN RETURN
  151.  COLOR 1,0
  152.  EFlag$="SAVE"
  153.  ON ERROR GOTO ErrorTrap
  154.  OPEN filename$ FOR OUTPUT AS #1
  155.  WRITE #1,TeamName$,GNumber,NPlayers,NWins,NLosses,NCSTATS,NGSTATS
  156.  FOR I=1 TO NPlayers
  157.   WRITE #1,PlayerName$(I)
  158.   FOR J=1 TO NGSTATS
  159.    WRITE #1,PGameStats(I,J)
  160.   NEXT J
  161.   FOR  J=1 TO NCSTATS
  162.    WRITE #1,PCumStats(I,J)
  163.   NEXT J
  164.  NEXT I
  165.  FOR I=1 TO GNumber
  166.   WRITE #1,GDates$(I),GScores$(I)
  167.   FOR J=1 TO NCSTATS
  168.    WRITE #1,TCumStats(I,J)
  169.   NEXT J
  170.  NEXT I
  171.  FOR I=1 TO NGSTATS
  172.   WRITE #1,TGameStats(I)
  173.  NEXT I
  174.  FOR J=1 TO NCSTATS
  175.   WRITE #1,TCumTotals(J)
  176.  NEXT J 
  177.  CLOSE #1
  178.  ON ERROR GOTO 0
  179.  FileFlag$="T"
  180. RETURN
  181.  
  182. PrintFile:
  183. EFlag$="PRINT"
  184. ON ERROR GOTO ErrorTrap
  185. OPEN "PRT:" FOR OUTPUT AS #1
  186. PRINT #1,
  187. PRINT #1,
  188. PRINT #1,CHR$(27);"[6w";
  189. PRINT #1,STRING$(40,ASC("*"))
  190. Temp$=" GAME STATISTICS"
  191. X=(40-LEN(TeamName$)-LEN(Temp$))/2
  192. PRINT #1,TAB(X);UCASE$(TeamName$)+Temp$
  193. PRINT #1,STRING$(40,ASC("*"))
  194. PRINT #1,CHR$(27);"[5w";
  195. GOSUB GPrint:PRINT #1,
  196. PRINT #1,CHR$(27);"[6w";
  197. PRINT #1,STRING$(40,ASC("*"))
  198. Temp$=" CUMULATIVE STATISTICS"
  199. X=(40-LEN(TeamName$)-LEN(Temp$))/2
  200. PRINT #1,TAB(X);UCASE$(TeamName$)+Temp$
  201. PRINT #1,STRING$(40,ASC("*"))
  202. PRINT #1,CHR$(27);"[5w";
  203. GOSUB CPrint:PRINT #1,
  204. PRINT #1,CHR$(27);"[6w";
  205. PRINT #1,STRING$(40,ASC("*"))
  206. Temp$=" SEASON HISTORY"
  207. X=(40-LEN(TeamName$)-LEN(Temp$))/2
  208. PRINT #1,TAB(X);UCASE$(TeamName$)+Temp$
  209. PRINT #1,STRING$(40,ASC("*"))
  210. PRINT #1,CHR$(27);"[5w";
  211. GOSUB HPrint:PRINT #1,
  212. CLOSE #1
  213. GOSUB LastScreen
  214. RETURN
  215.  
  216. Quit:
  217.  IF FileFlag$="F" THEN
  218.   CALL Requester("File Not Saved","","QUIT","NO!",0,X)
  219.   IF X=0 THEN RETURN
  220.  END IF  
  221.  MENU RESET
  222.  LIBRARY CLOSE
  223.  CLS
  224.  CLEAR ,25000
  225.  SYSTEM
  226.  END
  227. RETURN
  228.  
  229. Add:
  230.  IF NPlayers=NPMAX THEN
  231.   CALL Requester("Can't Add Anymore Players!","","OK","OK",0,X)
  232.   RETURN
  233.  END IF
  234.  NPlayers=NPlayers+1
  235.  Temp1$="Name of Player "+STR$(NPlayers)+" ?"
  236.  Temp$=""
  237.  CALL StringRequest("ADD",Temp1$,"OK","CANCEL",Temp$)
  238.  IF which=3 THEN
  239.   NPlayers=NPlayers-1
  240.   GOSUB LastScreen
  241.   RETURN
  242.  END IF
  243.  PlayerName$(NPlayers)=Temp$ 
  244.  GOTO Add
  245. RETURN
  246.  
  247. Delete1:
  248.   IF NPlayers=0 THEN
  249.   CALL Requester("No Players Left!","Can't Delete","OK","OK",0,Y)
  250.   RETURN
  251.  END IF
  252.  Temp1$="Name of Player to DELETE ?"
  253.  Temp$=""
  254.  CALL StringRequest("DELETE",Temp1$,"OK","CANCEL",Temp$)
  255.  IF which=3 THEN
  256.   GOSUB LastScreen
  257.   RETURN
  258.  END IF
  259.  X=0
  260.  FOR I=1 TO NPlayers
  261.   IF Temp$=PlayerName$(I) THEN X=I
  262.  NEXT I
  263.  IF X=0 THEN 
  264.   CALL Requester(Temp$ + " Not Found","Can't Delete","OK","OK",0,Y)
  265.   GOTO Delete1
  266.  END IF
  267.  FOR I=X TO NPlayers-1
  268.   PlayerName$(I)=PlayerName$(I+1)
  269.   FOR J=1 TO NGSTATS
  270.    PGameStats(I,J)=PGameStats(I+1,J):PGameStats(I+1,J)=0
  271.   NEXT J
  272.   FOR J=1 TO NCSTATS
  273.    PCumStats(I,J)=PCumStats(I+1,J):PCumStats(I+1,J)=0
  274.   NEXT J
  275.  NEXT I 
  276.  NPlayers=NPlayers-1
  277.  GOTO Delete1  
  278. RETURN
  279.  
  280. Enter:
  281.  GNumber=GNumber+1
  282.  IF GNumber>NGMAX THEN
  283.   CALL Requester("Max Number of","Games Exceeded","OK","OK",X)
  284.   GNumber=GNumber-1
  285.   GOSUB LastScreen
  286.   RETURN
  287.  END IF 
  288.  
  289.  CLS
  290.  FileFlag$="F"
  291.  LOCATE 11,20:COLOR 2
  292.  PRINT "Enter Game Date >>"
  293.  LOCATE 12,20:PRINT "(MM/DD/YY)"
  294.  COLOR 1:LOCATE 11,40:INPUT;"",GDates$(GNumber)
  295.  
  296.  CLS
  297.  LOCATE 11,20:COLOR 2
  298.  PRINT "Enter Game Score >>"
  299.  LOCATE 12,20:PRINT "(Winner x Loser y)"
  300.  COLOR 1:LOCATE 11,40:INPUT;"",GScores$(GNumber)
  301.  Temp1$= UCASE$(LEFT$(GScores$(GNumber),4))
  302.  Temp2$= UCASE$(LEFT$(TeamName$,4))
  303.  IF (Temp1$=Temp2$) THEN NWins=NWins+1 ELSE NLosses=NLosses+1  
  304.  
  305.  FOR I=1 TO NPlayers
  306.   CLS
  307.   LOCATE 21,1:COLOR 2
  308.   PRINT "Enter Game Stats for ";PlayerName$(I);" >>"
  309.   PRINT "(AB,R,H,RBI,SF,BB,2B,3B,HR,E,BP)";
  310.   COLOR 1
  311.   LOCATE 21,42:INPUT;"", Temp$
  312.   LOCATE 21,42:PRINT SPACE$(35);
  313.   IF Temp$="" THEN  Temp$="000000000000000"
  314.   FOR J=1 TO NGSTATS
  315.    PGameStats(I,J)=VAL(MID$(Temp$,J,1))
  316.   NEXT J  
  317.  NEXT I
  318.   CLS
  319.   GOSUB Update  
  320.   GOSUB LastScreen
  321.   FileFlag$="F"
  322. RETURN
  323.  
  324. Game:
  325.  MENU OFF
  326.  CLS
  327.  Scrn$="Game"
  328.  OPEN "SCRN:" FOR OUTPUT AS #1
  329.  GOSUB GPrint
  330.  CLOSE #1
  331.  RETURN
  332.  
  333. GPrint: 
  334.  COLOR 2:LOCATE 1,1
  335.  PRINT #1,"GAME NUMBER: ";:COLOR 1:PRINT #1, GNumber;TAB(22);:COLOR 2
  336.  PRINT #1,"DATE: ";:COLOR 1:PRINT #1,GDates$(GNumber);TAB(37);:COLOR 2
  337.  PRINT #1,"SCORE: ";:COLOR 1:PRINT #1,GScores$(GNumber):COLOR 2
  338.  PRINT #1,
  339.  PRINT #1," N ";"PLAYER";TAB(21);"AB";TAB(26);"R";TAB(30);"H";
  340.  PRINT #1,TAB(32);"RBI";TAB(36);"SAC";TAB(41);"BB";
  341.  PRINT #1,TAB(45);"2B";TAB(49);"3B";TAB(53);"HR";
  342.  PRINT #1,TAB(58);"E";TAB(60);"BHP" 
  343.  FOR I=1 TO NPlayers
  344.   COLOR 3
  345.   PRINT #1,USING"## ";I;
  346.   COLOR 1
  347.   PRINT #1,USING "\             \";PlayerName$(I);
  348.   COLOR 3                  
  349.   PRINT #1,TAB(20);:PRINT #1,USING "### ";PGameStats(I,AB);
  350.   PRINT #1,USING "### ";PGameStats(I,R);
  351.   PRINT #1,USING "### ";PGameStats(I,H);PGameStats(I,RBI);
  352.   PRINT #1,USING "### ";PGameStats(I,SF);PGameStats(I,BB);PGameStats(I,B2);
  353.   PRINT #1,USING "### ";PGameStats(I,B3);PGameStats(I,HR);PGameStats(I,E);
  354.   PRINT #1,USING "### ";PGameStats(I,BP)
  355.  NEXT I
  356.   COLOR 2:PRINT #1,"   TOTALS";:COLOR 1
  357.   PRINT #1,TAB(20);:PRINT #1,USING "### ";TGameStats(AB);
  358.   PRINT #1,USING "### ";TGameStats(R);
  359.   PRINT #1,USING "### ";TGameStats(H);TGameStats(RBI);
  360.   PRINT #1,USING "### ";TGameStats(SF);TGameStats(BB);TGameStats(B2);
  361.   PRINT #1,USING "### ";TGameStats(B3);TGameStats(HR);TGameStats(E);
  362.   PRINT #1,USING "### ";TGameStats(BP);
  363. RETURN
  364.   
  365. Cumulative:
  366.  MENU OFF
  367.  CLS
  368.  Scrn$="Cumulative"
  369.  OPEN "SCRN:" FOR OUTPUT AS #1
  370.  GOSUB CPrint
  371.  CLOSE #1
  372.  RETURN
  373.  
  374. CPrint: 
  375.  COLOR 2:PRINT #1,"GAMES PLAYED: ";:COLOR 1:PRINT #1,GNumber;TAB(30);
  376.  COLOR 2:PRINT #1,"TEAM NAME: ";:COLOR 1:PRINT #1,TeamName$;TAB(55);
  377.  COLOR 2:PRINT #1,"WON: ";:COLOR 1:PRINT #1,NWins;TAB(65);
  378.  COLOR 2:PRINT #1,"LOST: ";:COLOR 1:PRINT #1,NLosses
  379.  PRINT #1,:COLOR 2
  380.  PRINT #1," N ";"PLAYER";TAB(21);"G";TAB(24);"AB";TAB(29);"R";TAB(33);"H";
  381.  PRINT #1,TAB(35);"RBI";TAB(39);"SAC";TAB(44);"BB";
  382.  PRINT #1,TAB(48);"2B";TAB(52);"3B";TAB(56);"HR";
  383.  PRINT #1,TAB(61);"E";TAB(63);"BHP";TAB(69);"SLG";TAB(75);"AVG" 
  384.  FOR I=1 TO NPlayers
  385.   COLOR 3
  386.   PRINT #1,USING"## ";I;
  387.   COLOR 1
  388.   PRINT #1,USING "\             \";PlayerName$(I);
  389.   COLOR 3
  390.   PRINT #1,TAB(20);:PRINT #1,USING "## ";PCumStats(I,G);
  391.   PRINT #1,USING "### ";PCumStats(I,AB);
  392.   PRINT #1,USING "### ";PCumStats(I,R);
  393.   PRINT #1,USING "### ";PCumStats(I,H);PCumStats(I,RBI);
  394.   PRINT #1,USING "### ";PCumStats(I,SF);PCumStats(I,BB);PCumStats(I,B2);
  395.   PRINT #1,USING "### ";PCumStats(I,B3);PCumStats(I,HR);PCumStats(I,E);
  396.   PRINT #1,USING "### ";PCumStats(I,BP);
  397.   Temp$=" .### ":IF PCumStats(I,SLG)>=1000 THEN Temp$="#.### "
  398.   PRINT #1,USING Temp$;PCumStats(I,SLG)/1000;
  399.   Temp$=" .### ":IF PCumStats(I,AVG)=1000 THEN Temp$="#.### "
  400.   PRINT #1,USING Temp$;PCumStats(I,AVG)/1000
  401.  NEXT I
  402.   COLOR 2:PRINT #1,"   TOTALS";
  403.   COLOR 1
  404.   PRINT #1,TAB(20);:PRINT #1,"   ";
  405.   PRINT #1,USING "### ";TCumTotals(AB);
  406.   PRINT #1,USING "### ";TCumTotals(R);
  407.   PRINT #1,USING "### ";TCumTotals(H);TCumTotals(RBI);
  408.   PRINT #1,USING "### ";TCumTotals(SF);TCumTotals(BB);TCumTotals(B2);
  409.   PRINT #1,USING "### ";TCumTotals(B3);TCumTotals(HR);TCumTotals(E);
  410.   PRINT #1,USING "### ";TCumTotals(BP);
  411.   PRINT #1,USING " .### ";TCumTotals(SLG)/1000;
  412.   Temp$=" .### ":IF TCumTotals(AVG)=1000 THEN Temp$="#.### "
  413.   PRINT #1,USING Temp$;TCumTotals(AVG)/1000;
  414. RETURN
  415.  
  416. History:
  417.  MENU OFF
  418.  CLS
  419.  Scrn$="History"
  420.  OPEN "SCRN:" FOR OUTPUT AS #1
  421.  GOSUB HPrint
  422.  CLOSE #1
  423. RETURN 
  424.  
  425. HPrint:
  426.  COLOR 2
  427.  PRINT #1,TAB(32);"WON:";:COLOR 1:PRINT #1, USING "##  ";NWins;
  428.  COLOR 2:PRINT #1,"LOST:";:COLOR 1:PRINT #1,NLosses:COLOR 2
  429.  PRINT #1,
  430.  PRINT #1," N";TAB(4);"DATE";TAB(13);"SCORE";TAB(49);"AB";
  431.  PRINT #1,TAB(53);"H";TAB(55);"BB";TAB(58);"2B";TAB(61);"3B";
  432.  PRINT #1,TAB(64);"HR";TAB(68);"E";TAB(70);"BHP";TAB(75);"AVG"
  433.  COLOR 1
  434.  FOR I=1 TO GNumber
  435.  PRINT #1,USING "## ";I;
  436.  PRINT #1,USING "\       \";GDates$(I);
  437.  PRINT #1,GScores$(I);TAB(49);
  438.  PRINT #1,USING "## ";TCumStats(I,AB);TCumStats(I,H);TCumStats(I,BB);
  439.  PRINT #1,USING "## ";TCumStats(I,B2);TCumStats(I,B3);TCumStats(I,HR);TCumStats(I,E);
  440.  PRINT #1,USING " ## ";TCumStats(I,BP);
  441.  PRINT #1,USING ".###";TCumStats(I,AVG)/1000
  442.  NEXT I
  443.  COLOR 1
  444. RETURN 
  445.  
  446. ClearDB:
  447. '**** Intuits header ****
  448.  DEFINT a-z
  449. 'Global arrays and variables
  450.  DIM work%(400)
  451.  DIM x1(5),y1(5),x2(5),y2(5) 'more than 5 gadgets is impractical
  452.  ScrId=-1 'Screen for windows
  453.  which=0 'which box is selected
  454.  BoxIndex=1 'How many gadgets
  455.  maxlen=25 'length of text fields
  456. '**********************************
  457.  
  458.  X=0:Y=0:I=0:J=0:K=0
  459.  EFlag$=""
  460.  Scrn$="Game" 'Cumulative, Game or History
  461.  Temp1$="":Temp2$=""
  462.  TeamName$="NoName" 'Teamname
  463.  FileFlag$="F" 'File Saved flag
  464.  NPlayers=0 'Current number of players on roster
  465.  GNumber=0  'Current Game Number
  466.  filename$="NoName.Game0"
  467.  NPMAX=19   'Maximum Number of Players
  468.  NGMAX=19   'Maximum Number of Games
  469.  NWins=0:NLosses=0 'Current Number of wins and losses
  470.  NGSTATS=15 'AB,R,H,RBI,SF,BB,2B,3B,HR,E,BP
  471.  NCSTATS=20 'AB,R,H,RBI,SF,BB,2B,3B,HR,E,BP,G,SLG,AVG
  472.  AB=1:R=2:H=3:RBI=4:SF=5:BB=6:B2=7:B3=8
  473.  HR=9:E=10:BP=11:G=12:SLG=13:AVG=14
  474.  NCOMMON=11 'AB,R,H,RBI,SF,BB,2B,3B,HR,E,BP
  475.  DIM PlayerName$(NPMAX)   'Array of Player Names
  476.  FOR I=0 TO NPMAX
  477.  PlayerName$(I)="NoName"
  478.  NEXT I
  479.  DIM PGameStats(NPMAX,NGSTATS) 'Array of Player Game Stats
  480.  DIM PCumStats(NPMAX,NCSTATS) 'Array of player Cumulative stats
  481.  DIM TCumTotals(NCSTATS) 'Array of Team Cumulative stats
  482.  DIM GDates$(NGMAX)   'Array for game dates
  483.  DIM GScores$(NGMAX) 'Array for game scores
  484.  FOR I=0 TO NGMAX
  485.   GDates$(I)="NoDate"
  486.   GScores$(I)="NoScore" 
  487.  NEXT I
  488.  DIM TGameStats(NGSTATS) 'Array for Team Game Statistics
  489.  DIM TCumStats(NGMAX,NCSTATS)  'Array for Team History Stats
  490. RETURN 
  491.  
  492. LastScreen:
  493.  IF Scrn$="Cumulative" THEN 
  494.   GOSUB Cumulative
  495.  ELSEIF Scrn$="Game" THEN
  496.   GOSUB Game
  497.  ELSE
  498.   GOSUB History
  499.  END IF
  500. RETURN 
  501.  
  502. Update:
  503.  CLS:LOCATE 11,35:COLOR 0,1:PRINT "UPDATING......":COLOR 1,0
  504.  FOR I=1 TO NGSTATS
  505.   TGameStats(I)=0
  506.  NEXT I 
  507.  FOR I=1 TO NPlayers
  508.   IF (PGameStats(I,AB)<>0 OR PGameStats(I,BB)<>0 OR PGameStats(I,SF)<>0)THEN PCumStats(I,G)=PCumStats(I,G)+1
  509.   FOR J=1 TO NCOMMON
  510.    PCumStats(I,J)=PCumStats(I,J)+PGameStats(I,J)
  511.    TGameStats(J)=TGameStats(J)+ PGameStats(I,J)
  512.    TCumStats(GNumber,J)=TGameStats(J)
  513.    TCumTotals(J)=TCumTotals(J)+PGameStats(I,J)
  514.   NEXT J
  515.   IF PCumStats(I,AB)=0 THEN Skip1
  516.   PCumStats(I,AVG)=INT(PCumStats(I,H)/PCumStats(I,AB)*1000+.5)
  517. Skip1:
  518.   IF PCumStats(I,H)=0 THEN Skip2
  519.   X=PCumStats(I,H)-PCumStats(I,B2)-PCumStats(I,B3)-PCumStats(I,HR) 
  520.   PCumStats(I,SLG)=INT(1000*(X+PCumStats(I,B2)*2+PCumStats(I,B3)*3+PCumStats(I,HR)*4)/(PCumStats(I,AB))+.5)
  521. Skip2:
  522.  NEXT I
  523.   IF TCumStats(GNumber,AB)=0 THEN Skip3
  524.   TCumTotals(AVG)=INT(TCumTotals(H)/TCumTotals(AB)*1000+.5)
  525.   TCumStats(GNumber,AVG)=INT(TCumStats(GNumber,H)/TCumStats(GNumber,AB)*1000+.5)
  526. Skip3:
  527.   IF TCumStats(GNumber,H)=0 THEN Skip4
  528.   X=TCumStats(GNumber,H)-TCumStats(GNumber,B2)-TCumStats(GNumber,B3)-TCumStats(GNumber,HR) 
  529.   TCumStats(GNumber,SLG)=INT(1000*(X+TCumStats(GNumber,B2)*2+TCumStats(GNumber,B3)*3+TCumStats(GNumber,HR)*4)/(TCumStats(GNumber,H)*4)+.5)
  530.   X=TCumTotals(H)-TCumTotals(B2)-TCumTotals(B3)-TCumTotals(HR) 
  531.   TCumTotals(SLG)=INT(1000*(X+TCumTotals(B2)*2+TCumTotals(B3)*3+TCumTotals(HR)*4)/(TCumTotals(AB))+.5)
  532. Skip4:
  533.   GOSUB Sorter
  534. RETURN
  535.  
  536. Sorter:
  537.  CLS:LOCATE 11,35:COLOR 0,1:PRINT "SORTING......":COLOR 1,0
  538.  FOR I=1 TO NPlayers-1
  539.   FOR J=I+1 TO NPlayers
  540.    IF PCumStats(J,AVG)>PCumStats(I,AVG) THEN
  541.     SWAP PlayerName$(I),PlayerName$(J)
  542.     FOR X=1 TO NGSTATS
  543.      SWAP PGameStats(I,X),PGameStats(J,X)
  544.      SWAP PCumStats(I,X),PCumStats(J,X)
  545.     NEXT
  546.     FOR X=NGSTATS+1 TO NCSTATS
  547.      SWAP PCumStats(I,X),PCumStats(J,X)
  548.     NEXT
  549.    END IF
  550.  NEXT:NEXT    
  551. RETURN    
  552.  
  553. SUB OpenRequest(filename$) STATIC
  554. CALL StringRequest("Open Request","Open filename:","Open","Cancel",filename$)
  555. END SUB
  556. SUB SaveRequest(filename$) STATIC
  557. CALL StringRequest("Save Request","Save as:","Save","Cancel",filename$)
  558. END SUB
  559.  
  560. SUB StringRequest(title$,msg$,b1$,B2$,default$) STATIC
  561. SHARED maxlen,ScrId,which,BoxIndex
  562. BoxIndex=1:height=PEEKW(WINDOW(8)+58)
  563. winwidth=maxlen*(8-2*(height=9))+40
  564. WINDOW 2,title$,(0,0)-(winwidth,80),0,ScrId
  565. PRINT:PRINT "  ";msg$:PRINT  
  566. PRINT " ";:CALL TxBox(default$+SPACE$(1+maxlen-LEN(default$))) 'reserve space
  567. Xpos=2:Ypos=CSRLIN 'for GetString
  568. PRINT :PRINT :LOCATE ,2:CALL TxBox(b1$)
  569. PRINT TAB(maxlen+3-LEN(B2$));:CALL TxBox(B2$)
  570. which=0
  571. WHILE which<=1
  572.   CALL WaitBox(which) 'Get box #
  573.   IF which=1 THEN 'if GetString
  574.     CALL GetString(Xpos,Ypos,default$)
  575.   END IF
  576. WEND 'must be Open or Cancel
  577. CALL FlashRelease(which) 'Flash the box
  578. WINDOW CLOSE 2
  579. IF which=BoxIndex-1 THEN filename$=""
  580. END SUB
  581.  
  582.  
  583. SUB Request(msg1$,msg2$,b1$,B2$,which) STATIC
  584. SHARED BoxIndex,ScrId
  585. SHARED x1(),y1(),x2(),y2()
  586. BoxIndex=1:height=PEEKW(WINDOW(8)+58)
  587. winwidth=20*(8-2*(height=9))+30
  588. WINDOW 2,"System Request",(0,0)-(winwidth,50),0,ScrId
  589. PRINT :PRINT TAB(11-LEN(msg1$)/2);msg1$
  590. PRINT TAB(11-LEN(msg2$)/2);msg2$:PRINT        
  591. LOCATE ,2:TxBox b1$
  592. PRINT TAB(20-LEN(B2$));:TxBox B2$:which=0
  593. CALL WaitBox(which)
  594. CALL FlashRelease(which)
  595. WINDOW CLOSE 2
  596. END SUB
  597.  
  598.  
  599. SUB FlashRelease(which) STATIC
  600. SHARED x1(),y1(),x2(),y2(),work%()
  601. SHARED RelVerify
  602. 'These two lines flash the box
  603. GET (x1(which),y1(which))-(x2(which),y2(which)),work%
  604. PUT (x1(which),y1(which)),work%,PRESET
  605. ix=MOUSE(1):iy=MOUSE(2):RelVerify=-1
  606. WHILE MOUSE(0)<>0
  607. IF MOUSE(1)<>ix OR MOUSE(2)<>iy THEN RelVerify=0
  608. WEND
  609. 'This line restores the box
  610. PUT (x1(which),y1(which)),work%,PSET
  611. END SUB
  612.  
  613. SUB TxBox(msg$) STATIC
  614. SHARED x1(),y1(),x2(),y2()
  615. SHARED BoxIndex
  616. x1=WINDOW(4):y1=WINDOW(5)-10
  617. PRINT " ";msg$;" ";
  618. x2=WINDOW(4):y2=y1+14
  619. CALL Box(BoxIndex,x1,y1,x2,y2)
  620. BoxIndex=BoxIndex+1
  621. PRINT SPC(1);
  622. END SUB
  623.  
  624. SUB Box(I,x1,y1,x2,y2) STATIC
  625. SHARED x1(),y1(),x2(),y2()
  626. IF x2<x1 THEN SWAP x1,x2
  627. LINE (x1,y1)-(x2,y2),1-(WINDOW(6)>1),b
  628. LINE (x1,y1)-(x2-1,y2-1),1,b
  629. x1(I)=x1:y1(I)=y1:x2(I)=x2:y2(I)=y2
  630. END SUB
  631.  
  632. SUB CheckBox(I,flag) STATIC
  633. SHARED x1(),y1(),x2(),y2()
  634. x1=x1(I)+2:y1=y1(I)+2
  635. x2=x2(I)-2:y2=y2(I)-2
  636. LINE (x1+3,y1+3)-(x2-3,y2-3),WINDOW(6)*-(flag<>0),BF
  637. END SUB
  638.  
  639. SUB WaitBox(which) STATIC
  640. which=0
  641. WHILE which=0
  642.   CALL WhichBox(which)
  643. WEND
  644. EXIT SUB
  645. RETURN
  646. END SUB
  647.  
  648. SUB WhichBox(which) STATIC
  649. SHARED x1(),y1(),x2(),y2(),BoxIndex
  650. IF MOUSE(0)=0 THEN EXIT SUB
  651. X=MOUSE(1):Y=MOUSE(2):I=1
  652. WHILE I<BoxIndex AND NOT (X>x1(I) AND X<x2(I) AND Y>y1(I) AND Y<y2(I))
  653.   I=I+1
  654. WEND
  655. which=I:IF I=BoxIndex THEN which=0
  656. END SUB
  657.  
  658. SUB GetString(Xpos,Ypos,default$) STATIC
  659. SHARED maxlen,which
  660. answer$=default$
  661. IF maxlen=0 THEN maxlen=40
  662. 'Cursor appears at end of default string
  663. csr=LEN(default$)+1
  664. K$=""
  665. WHILE K$<>CHR$(13)
  666.     LOCATE Ypos,Xpos+1:PRINT default$;" ";
  667.     LOCATE Ypos,Xpos+csr
  668.     COLOR 0,WINDOW(6) 'cursor is max color
  669.     PRINT MID$(default$+" ",csr,1)
  670.     COLOR 1,0:K$=""
  671.   WHILE K$="":K$=INKEY$
  672.     CALL WhichBox(I)
  673.     IF I>1 AND I<>which THEN which=I:K$=CHR$(13)
  674.   WEND
  675.   LOCATE Ypos,Xpos+1:PRINT default$;" ";
  676.   K=ASC(K$)
  677.   IF K>=32 AND K<127 THEN  
  678.     default$=LEFT$(default$,csr-1)+K$+MID$(default$,csr)
  679.     default$=LEFT$(default$,maxlen)
  680.     csr=csr-(csr<maxlen)
  681.   END IF
  682.   IF K=31 OR K=8 THEN csr=csr+(csr>1)
  683.   IF K=127 OR K=8 THEN
  684.     default$=LEFT$(default$,csr-1)+MID$(default$,csr+1)
  685.   END IF
  686.   IF K=30 THEN csr=csr-(csr<maxlen)
  687. WEND               
  688. END SUB
  689. RETURN
  690.  
  691. ErrorTrap:
  692.  BEEP ' Get user's attention.
  693.  IF ERR=53 THEN
  694.   request1$="FILE NOT FOUND."
  695.   GOTO ExitError
  696.  END IF
  697.  IF ERR=61 THEN
  698.   request1$="DISK FULL."
  699.   GOTO ExitError
  700.  END IF
  701.  IF ERR=64 THEN
  702.   request1$="BAD FILENAME."
  703.   GOTO ExitError
  704.  END IF
  705.  IF ERR=67 THEN
  706.   request1$="DIRECTORY FULL."
  707.   GOTO ExitError
  708.  END IF
  709.  IF ERR=68 THEN
  710.   request1$="DEVICE UNAVAILABLE."
  711.   GOTO ExitError
  712.  END IF 
  713.  IF ERR=70 THEN
  714.   request1$="DISK WRITE-PROTECTED."
  715.   GOTO ExitError
  716.  END IF
  717.  IF ERR=74 THEN
  718.   request1$="UNKNOWN DISK VOLUME."
  719.   GOTO ExitError
  720.  END IF
  721.  request1$="ERROR NUMBER"+STR$(ERR)
  722.  ExitError:
  723.  ' Abort operation or try again.
  724.  ' Define global variable scrid (SCREEN ID) if required:
  725.  ScrId=-1 'Error Requester will appear on Workbench screen.
  726.  CALL Requester (request1$,"","Retry","CANCEL",2,answer%)
  727.  IF answer%=0 THEN
  728.   CLOSE #1
  729.   X=1:GOSUB Ghost
  730.   RESUME Iloop ' Substitute your reentry point here.
  731.  ELSE
  732.   CLOSE #1
  733.   IF EFlag$="OPEN" THEN 
  734.    RESUME OpenFile
  735.   ELSEIF EFlag$="SAVE" THEN
  736.    RESUME SaveFile
  737.   ELSE
  738.    RESUME 
  739.   END IF
  740.   END IF
  741.   
  742. SUB Requester (msg1$,msg2$,b1$,B2$,hilite%,answer%) STATIC
  743.  SHARED ScrId 'Global variable for SCREEN ID.
  744.  IF ScrId<1 OR ScrId>4 THEN ScrId=-1 'Default to Workbench.
  745.  WINDOW 3,"Program Request",(0,0)-(311,45),16,ScrId
  746.  maxwidth=INT(WINDOW(2)/8) 'Truncate prompts if too long...
  747.  PRINT LEFT$(msg1$,maxwidth):PRINT LEFT$(msg2$,maxwidth)
  748.  b1$=LEFT$(b1$,12):B2$=LEFT$(B2$,12) 'Truncate buttons.
  749.  bsize1=(LEN(b1$)+2)*10:bsize2=(LEN(B2$)+2)*10 'Button size.
  750.  x1=(312-(bsize1+bsize2))/3  'Calculate button positions...
  751.  x2=x1+bsize1:x3=x1+x2:x4=x3+bsize2
  752.  'Draw buttons:
  753.  LINE (x1,20)-(x2,38),2,b:LINE (x3,20)-(x4,38),2,b
  754.  IF hilite%=1 THEN LINE (x1+2,22)-(x2-2,36),3,b
  755.  IF hilite%=2 THEN LINE (x3+2,22)-(x4-2,36),3,b
  756.  LOCATE 4,1:PRINT PTAB(x1+10);b1$;
  757.  PRINT PTAB(x3+10);B2$
  758.  Reqloop: 'Loop which acts on mouse clicks...
  759.  WHILE MOUSE(0)=0:WEND:m1=MOUSE(1):m2=MOUSE(2)
  760.  IF m1>x1 AND m1<x2 AND m2>20 AND m2<38 THEN
  761.   answer%=1 'Left button was selected.
  762.   LINE (x1,20)-(x2,38),1,BF 'Flash left button.
  763.  ELSEIF m1>x3 AND m1<x4 AND m2>20 AND m2<38 THEN
  764.   answer%=0 'Right button was selected.
  765.   LINE (x3,20)-(x4,38),1,BF 'Flash right button.
  766.  ELSE
  767.   GOTO Reqloop 'Neither button selected; repeat loop.
  768.  END IF
  769.  WHILE MOUSE(0)<>0:WEND:WINDOW CLOSE 3
  770. END SUB
  771.  
  772.